          SUBROUTINE (INIT.PN,INIT.AOD,INIT.BR,BT.CN,VIEW.NO,LDATA,ST.CN)
** Version# 158.0001[8] - 09/27/2011 - 11:11pm - SMITJR - eclipse
*** V158.0001 Change - Custom Coding . - 09/27/2011 - SMITJR - eclipse

*** Subroutine: INV.HISTORY.LEDGER
*-------------------------------------------------------------------------*
*** This program displays the inventory history ledger inquiry.  Records
*** are read from the PSUB file.
*-------------------------------------------------------------------------*
*** INIT.PN     Internal part# passed from calling program            (In)
*** INIT.AOD    As of date passed from calling program                (In)
*** BR          Branch to display data for                            (In)
*** BT.CN       Billto customer# to display data for.  If null
***             will display for all.                                 (In)
*** VIEW.NO     Default view passed from calling program              (In)
*** LDATA       Invoice data for returns                              (In)
*** ST.CN       Shipto customer# for display shipto data only         (In)
*-------------------------------------------------------------------------*
          MATBUILD SAVE.LED    FROM LED
          MATBUILD SAVE.LD     FROM LD
          MATBUILD SAVE.OLED   FROM OLED
          MATBUILD SAVE.OLD.LD FROM OLD.LD
          DIM LD2(50)

          DFLT.SO  = VIEW.NO<1,2>
          VIEW.NO  = VIEW.NO<1,1>

          KEEP.CN  = NO
          OPEN.SNS = NO
          ST.ONLY  = NO
          AOD      = INIT.AOD
          BR       = INIT.BR

          SCREEN

          GOSUB INIT

          IF LDATA = '1' THEN PROMPT.MSG=YES ELSE PROMPT.MSG=NO
          LDATA    = ''
          CHECK.KEY 'SUPERUSER',COGS.OK
          CHECK.KEY 'COST.VIEW',COST.OK
          CHECK.KEY 'PO.PRICE.VIEW', PO.OK
          * Check if the User is Authed to see prices on transfer orders.
          CHECK.KEY 'TO.PRICE.VIEW', TO.OK, TO.LEVEL
          CHECK.KEY 'OE.PRODUCT.TYPE.EDIT',TYPE.OK
          * check if the user is limited to view the history information
          * cannot use CHECK.KEY, since the SUPERUSER will get YES to
          * limit the viewing.
          LOCATE 'INV.SLS.LIMIT.DETAIL' IN AUTH.KEYS<1> SETTING POS THEN
             LIMIT.VIEW  = YES
             LIMIT.LEVEL = AUTH.LVLS<1,POS>
          END ELSE
             LIMIT.VIEW  = NO
             LIMIT.LEVEL = ''
          END
          READ STATUSES FROM CTRLFILE,'PROD.STATUS' ELSE STATUSES = ''
          READ EXCLUDE.UNVERF.IP FROM CTRLFILE,'EXCLUDE.UNVERF.IP' ELSE
             EXCLUDE.UNVERF.IP = NO
          END
*-------------------------------------------------------------------------*
START:    LN.IDS  = ''
          LN.OHS  = ''
          LN.VFLG = ''
          LINE    = 1
          SV.LINE = 1
          SV.ID   = ''
          RFM.IDS = ''
          EOF     = NO
          TOP     = 0
          MXL     = 0
          COL     = 1
          IF NOT(BR)      THEN BR      = SECURITY<7,1>
          IF NOT(BR)      THEN BR      = 1
          IF NOT(VIEW.NO) THEN VIEW.NO = 1

          CLEAR.SCREEN
          VIEW.CURR = 1
          PRINT @(14,1):OCONV(AOD,'D4/')          "L#10"
          PRINT @(29,1):BR                        "L#4"
          PRINT @(14,2):OCONV(CN,'TENTITY;X;1;1') "L#35"
          IF NOT(RESEL) THEN
             PN = INIT.PN
             * Don't get rid of the CN that we just displayed.
             KEEP.CN = YES
             GOSUB INIT
             KEEP.CN = NO
          END ELSE
             RESEL = NO
             IF NEW.LPAT THEN
                NEW.LPAT = NO
             END ELSE
                L.PAT = ''
             END
          END
          IF ST.CN THEN
             IF NOT(ST.ONLY) THEN
                PRINT @(60,21):'Ship-To ONly'
             END ELSE
                PRINT @(60,21):'Bill-To INcl'
             END
          END ELSE
             PRINT @(60,21):'            '    ;** Blank out hotkey.
          END
          GOTO GET.PRD
*-------------------------------------------------------------------------*
GET.PRD:  IF PN='' THEN GOTO IN.PN
          GET.ALL.PRD BR,PN
          DFLT.PER.GET 'I',PER,UM
          PRICE.PER.GET PPER.QTY,PPER.UM

          GOSUB DISP.VIEW
          PRINT @(8,3):PRD(1)<1,1>    "L#35"
          PRINT @(8,4):PRD(1)<1,2>    "L#35"
          PRINT @(8,5):PRD(1)<1,3>    "L#35"
          PRINT @(42,1):STATUSES<1,PRD(3)<1,1>> "L#8"

          ROOT = PN:'~':BR:'~'
          IF AOD THEN ROOT := AOD'R%5':'~'
          ROOT := 'z'

          WIN.OPEN = NO
          IF CN THEN
             PRINT HOLDOFF$
             WINDOW.CHILD 10,3,35,1,3
             PRINT @(11,3):BLINK$:'Press <Enter> to Halt Search...':NORM$
             WIN.OPEN = YES
IN$$2:       INPUTCLEAR
          END

          OH = INV.OH(PN,BR,AOD,EXCLUDE.UNVERF.IP)
          INV.GET.TOTALS PN,BR,STK.OH,TAG.OH,STK.CMTD,TAG.CMTD,STK.PO,TAG.PO,STK.XFER,TAG.XFER,OTHER,ON.BID,STK.INPR,TAG.INPR,,STK.WO,TAG.WO

          GOSUB DISP.HDR
          LINE=0; TOP=0; LN.OHS = OH
          GOSUB PG.UP

          IF WIN.OPEN THEN
             WINDOW.CHILD.CLOSE
          END

          GOSUB HOT.KEYS

          IF PROMPT.MSG THEN
             IF LN.IDS='' THEN
                MSG  = 'No items found. Change Br or Date select criteria '
                MSG := 'or press Esc to exit.'
             END ELSE
                MSG='Position Cursor on Original Order and Press <Esc>...'
             END
             ERR.MESS 1,1,MSG
          END ELSE
             GOSUB NONE.MSG
          END
          IF PROMPT.MSG THEN
             LINE=1; IF LINE<1 THEN LINE=1
          END ELSE
             LINE=TOP; IF LINE<1 THEN LINE=1
          END
*-------------------------------------------------------------------------*
MOVENEXT: *INP X,1,TOP-LINE+7,0
          IF COL = 2 THEN GOSUB IN.TYPE ELSE GOSUB IN.OID
          BEGIN CASE
          CASE QUIT AND INIT.PN;       GOTO FINISH
          CASE QUIT AND NOT(INIT.PN);  RESEL = NO;    GOTO START
          CASE MOVE=1;                 COL = 1;       GOTO MOVENEXT
          CASE MOVE=2;                 GOSUB UP.LINE; GOTO MOVENEXT
          CASE MOVE>3;                 GOSUB DN.LINE; GOTO MOVENEXT
          CASE MOVE=3;                 GOSUB IN.TYPE; GOTO MOVENEXT
          CASE LASTKEY=12;             GOSUB PG.UP;   GOTO MOVENEXT
          CASE LASTKEY=14;             GOSUB PG.DN;   GOTO MOVENEXT
          CASE OTHERWISE;                             GOTO MOVENEXT
          END CASE
*-------------------------------------------------------------------------*
IN.OID:   IF VIEW.NO = 7 THEN
INOID1:      INP X,1,TOP-LINE+8,0
          END ELSE
INOID2:      INP X,1,TOP-LINE+8,0
          END
          RETURN
*-------------------------------------------------------------------------*
IN.DT:    INP AOD,14,1,10,'D4/'
          IF QUIT THEN GOTO FINISH
          ON MOVE+1 GOTO IN.DT,IN.DT,IN.DT,IN.BR,IN.CN,IN.BR
*-------------------------------------------------------------------------*
IN.BR:    INP.BR 29,1,4,BR
          IF QUIT THEN GOTO FINISH
          ON MOVE+1 GOTO IN.BR,IN.DT,IN.BR,IN.BR,IN.CN,IN.CN
*-------------------------------------------------------------------------*
IN.CN:    IF REMOTE.CUST THEN
             CN = REMOTE.CUST
          END ELSE
IN$$1:       INP CN,14,2,35,VERIFY='S:VERF.ENT.ID'
          END
          PRINT @(14,2):OCONV(CN,'TENTITY;X;9;9')"L#30"
          IF QUIT THEN GOTO FINISH
          ON MOVE+1 GOTO IN.CN,IN.CN,IN.DT,IN.CN,IN.PN,IN.PN
*-------------------------------------------------------------------------*
IN.PN:    INP DESC,8,3,35
          IF QUIT THEN GOTO FINISH
          IF MOVE = 2 THEN GOTO IN.CN

          PN = ''
          IF CN#'' THEN
             ENTITY.PN.GET CN,CN,,DESC,PN
          END

          IF PN='' THEN
             MODE = 1
             GOSUB SEL.PN
          END

          IF PN='' THEN PRINT BELL:; GOTO IN.PN
          READV X FROM PRDFILE,PN,1 ELSE PRINT BELL:; GOTO IN.PN
          ON MOVE+1 GOTO IN.PN,IN.PN,IN.CN,IN.PN,IN.PN,GET.PRD
          GOTO IN.PN
*-------------------------------------------------------------------------*
SEL.PN:   *** search for products
          LASTKEY = 0

          BEGIN CASE
          CASE MODE = 1
             IF NOT(FILTER.ACTIVE.PRD$) THEN
                MODE = 2
                GOTO SEL.PN
             END
             TITLE  = 'Active Product for Br#':BR
             FLNM   = 'ZZPROD.IDX:':BR
             IDICT  = '&INDEX&'
          CASE MODE = 2
             TITLE  = 'Product Primary Index'
             FLNM   = 'PRODUCT'
             IDICT  = '&INDEX&'
          CASE MODE = 3
             TITLE  = 'Product Catalog Index'
             FLNM   = 'PRODUCT'
             IDICT  = '&INDEX&.CAT'
          CASE OTHERWISE
             GOTO   RTN.SEL
          END CASE

          FINDID PN,DESC,FLNM,'CALL SEL.CONV.PRD',8,3,35,70,,IDICT,,,TITLE
          IF LASTKEY = 138 OR (PN='' AND NOT(QUIT)) THEN
             MODE += 1
             GOTO SEL.PN
          END

RTN.SEL:  MOVE = 5
          HELP = 0

          RETURN
*-------------------------------------------------------------------------*
HOT.KEYS: MENU.CLEAR

          MENU.LOAD 74,19, 4, 1,'S';    ** Show
          MENU.LOAD  1,19, 4, 1,"V";    ** View
          * Don't make Location Hotkey active when viewing a Lot Item.
          IF PRD(3) # 9 THEN
             MENU.LOAD  6,19, 9, 1,"L"; * Locations
          END ELSE
             MENU.LOAD '','','','',''
          END
          MENU.LOAD 16,19,11, 1,'F';    * Future Ledger
          MENU.LOAD 28,19, 9, 1,'I';    * Inventory Inquiry
          MENU.LOAD 38,19, 5, 1,'P';    * Print
          MENU.LOAD 44,19, 9, 1,'C';    * Change View
          MENU.LOAD 54,19,10, 7,'H';    * Sales History
          MENU.LOAD 65,19, 4, 3,'G';    * Log
          MENU.LOAD 69,19, 4, 1,'X';    * Xref
          MENU.LOAD  2,21,10, 6,'E';    * Serial # Entry
          MENU.LOAD 15,21, 4, 2,'A';    * Change As of Date
          MENU.LOAD 22,21, 2, 1,'B';    * Change Branch
          MENU.LOAD 27,21, 8, 3,'O';    * P/O Search
          MENU.LOAD 38,21, 8, 4,'T';    * Edit Location
          MENU.LOAD 49,21, 8, 5,'D';    * Search Lot Item Mat'l Det
          IF ST.CN THEN
             MENU.LOAD 60,21,13,10,'N'; * Ship-to Only
          END ELSE
             MENU.LOAD ,,,,
          END
          MENU.LOAD 74,21, 5, 5, 'Q';   * Branch Cost Inquiry

          RETURN
*-------------------------------------------------------------------------*
IN.TYPE:  ID = LN.IDS<LINE>

          IF NOT(TYPE.OK) THEN
             PRINT BELL:
             COL = 1
             RETURN
          END
          IF COL = 1 THEN NEED.MOVE = YES ELSE NEED.MOVE = NO
          COL = 2

          TYPE   = FIELD(ID,'~',7)
          OTYPE  = TYPE
          DIFFBR = FIELD(ID,'~',10)

          IF DIFFBR OR (TYPE # 'S' AND TYPE # 'E') THEN
             IF LINE = TOP THEN
                MOVE = 0; LINE = SV.LINE; COL = 1; LASTKEY=''
             END ELSE MOVE = 3; COL = 1
             RETURN
          END ELSE SV.LINE = LINE

          * View number 2 and view number 3 do not have type in them
          IF VIEW.NO = 2 OR VIEW.NO = 3 OR VIEW.NO = 7 THEN
             MOVE = ''; LASTKEY = ''; COL = 1
             RETURN
          END

IN$$3:    INP NEW.TYP,25,TOP-LINE+8,1,'MCU',V_"D:,Stock,Except"
          IF F12 THEN RETURN TO FINISH
          IF NOT(CHANGED) THEN
             IF NEED.MOVE THEN GOSUB MAN.MOVE
             RETURN
          END
          IF NEW.TYP = '' THEN
             NEW.TYP = OTYPE
             PRINT @(25,TOP-LINE+8):NEW.TYP"L#1"
             GOTO IN$$3
          END
          TYPE   = NEW.TYP
          OLD.ID = ID
          CONVERT '~' TO VM IN ID
          ID<1,7> = TYPE
          CONVERT VM TO '~' IN ID
          READ TST.REC FROM PSUBFILE,ID ELSE
             GOSUB UPD.TYPE
             IF NOT(UPD.OK) THEN
                ID = OLD.ID
                PRINT BELL
             END
          END
          LN.IDS<LINE> = ID
          GOSUB DISP.LN
          IF QUIT THEN RETURN TO FINISH
          IF NEED.MOVE THEN GOSUB MAN.MOVE
          RETURN
*-------------------------------------------------------------------------*
MAN.MOVE: *** Don't make the user hit multiple keys after switching columns
          *** It accomidate move manually outside of sub MOVENEXT
          BEGIN CASE
          CASE MOVE=2;           GOSUB UP.LINE
          CASE MOVE>3;           GOSUB DN.LINE
          CASE MOVE=3;           GOSUB IN.TYPE
          CASE LASTKEY=12;       GOSUB PG.UP
          CASE LASTKEY=14;       GOSUB PG.DN
          CASE OTHERWISE; NULL
          END CASE
          RETURN
*-------------------------------------------------------------------------*
UPD.TYPE: *** Update Location Type

          UPD.OK = NO
          OID    = FIELD(ID,'~',4)
          INVN   = FIELD(ID,'~',5)+0
          NO.MSG = YES
          OE.LOCK.LED OID,LOCK.MSG,NO.MSG
          IF LOCK.MSG THEN
             LOCK.MSG = LOCK.MSG<1>
             IF LOCK.MSG[1,3] = 'You' THEN
                LOCK.MSG = FIELD(LOCK.MSG,',',1)
             END
             MESS 1,2,LOCK.MSG
IN$$4:       INPNO A,,,0
             RETURN
          END

          LOCATE INVN IN LED(8)<1> SETTING GEN ELSE
             ERR = YES
             OE.UNLOCK.LED OID
             RETURN
          END

          LDID = FIELD(ID,'~',6)+0
          LD.GET LDID
          IF NOT(NUM(LD(1))) THEN
             ERR = YES
             OE.UNLOCK.LED OID
             RETURN
          END

          MAT OLD.LD = MAT LD
          TMP.TYP = OTYPE:'~':FIELD(ID,'~',8)
          LOCATE TMP.TYP IN LD(7)<1,GEN> SETTING TPOS ELSE
             ERR = YES
             OE.UNLOCK.LED OID
             RETURN
          END

          LD(7)<1,GEN,TPOS> = TYPE:'~':FIELD(ID,'~',8)

          UPDATE.PRDD OID,GEN,LDID
          RELEASE PRDDFILE,LD(1)
          IF LD(31)#'' THEN
             CP.CT = DCOUNT(LD(31),VM)
             FOR J = 1 TO CP.CT
                RELEASE PRDDFILE,LD(31)<1,J>
             NEXT J
          END

          UPDATE.LEDGER.DET OID,LDID,1,'',''
          UPDATE.LEDGER OID,''
          OE.UNLOCK.LED OID

          * Reset top bscan id since the index changed.
          IF SV.ID THEN
             IF LINE = TOP THEN
                SV.ID = FIELD(SV.ID,'~',1,6)
             END
             BSCAN SV.ID FROM PSUBFILE,SV.ID USING '&INDEX&' BY 'D' ELSE
                EOF = YES
             END
          END

          UPD.OK = YES

          RETURN
*-------------------------------------------------------------------------*
UP.LINE:  IF LINE < TOP THEN LINE += 1 ELSE
             IF TOP=MXL THEN GOSUB UP.ONE; IF EOF THEN PRINT BELL:; RETURN
             SCROLL.DOWN 1,8,78,17,1
             TOP += 1
             LINE = TOP
             GOSUB DISP.LN
          END
          RETURN
*-------------------------------------------------------------------------*
DN.LINE:  IF LINE > TOP-9 THEN LINE -= 1 ELSE
             IF TOP < 11 THEN PRINT BELL:; MOVE = 2; RETURN
             SCROLL.UP 1,8,78,17,1
             TOP -= 1
             LINE = TOP-9
             GOSUB DISP.LN
          END
          RETURN
*-------------------------------------------------------------------------*
PG.UP:    FOR X=1 TO 10
             IF COL = 2 THEN GOSUB SAVE.LN
             IF EOF AND TOP=MXL THEN EXIT ELSE GOSUB UP.LINE
          NEXT X
          MOVE = 4
          RETURN
*-------------------------------------------------------------------------*
PG.DN:    FOR X=1 TO 10
             IF COL = 2 THEN GOSUB SAVE.LN
             IF LINE=1 THEN EXIT ELSE GOSUB DN.LINE
          NEXT X
          MOVE = 2
          RETURN
*-------------------------------------------------------------------------*
SAVE.LN:  *** Save each line type as we go in case we get stuck.
          IF COL = 2 THEN
             TYPE  = FIELD(ID,'~',7)
             OTYPE = TYPE
             IF TYPE # 'S' AND TYPE # 'E' ELSE
                SV.LINE = LINE
             END
          END
          RETURN
*-------------------------------------------------------------------------*
DISP.LN:  ID     = LN.IDS<LINE>
          UNVERF = LN.VFLG<LINE>
          DT     = FIELD(ID,'~',3)+0
          OID    = FIELD(ID,'~',4)
          INVN   = FIELD(ID,'~',5)
          LDID   = FIELD(ID,'~',6)
          MODE   = OID[1,1]

          READ REC FROM PSUBFILE,ID ELSE REC = ''
          QTY = REC<1>/PER

          GOSUB GET.TYPE

          IF VIEW.NO # 7 THEN
             C1 = (OID:'.':INVN'R%3') 'L#14'
          END ELSE
             READ TLED FROM LEDFILE,OID ELSE TLED = ""
             LOCATE (INVN+0) IN TLED<8> SETTING TGN ELSE TGN = 1
             C1 = TLED<13,TGN> 'L#19'
          END
          C2 = OCONV(DT,'D2/')     'L#8'
          PRINT @(1,TOP-LINE+8):C1:'':C2:'':
          BEGIN CASE
          CASE MODE='A' OR MODE = 'J'
             READV CMNT FROM LEDFILE,OID,80 ELSE CMNT = ''
          CASE MODE='T' AND QTY > 0
             READV BRS FROM LEDFILE,OID,2 ELSE BRS = ''
             CMNT = 'Br: ':BRS<1,1,2>:' In'
          CASE MODE='T' AND QTY < 0
             READV BRS FROM LEDFILE,OID,2 ELSE BRS = ''
             CMNT = 'Br: ':BRS<1,2,2>:' Out'
          CASE OTHERWISE
             CRTL.ID = 'HIST.FUT.LEDGER.DISP'
             READ DISP.OPT FROM CTRLFILE,CRTL.ID ELSE DISP.OPT = 'I'
             IF DISP.OPT = 'I' THEN ATTB = 9 ELSE ATTB = 1
             READV CMNT FROM CUSFILE,REC<5>,ATTB ELSE CMNT = ''
             IF CMNT = '' THEN
                READV CMNT FROM CUSFILE,REC<4>,ATTB ELSE
                   CMNT = '* Not Found *'
                END
             END
          END CASE

          * Figure out if the user should be able to see prices on
          * transfer orders. To be able to, the user must either:
          * - Have a TO.PRICE.VIEW key level of 2 or above
          *                     OR
          * - Be Authorized for both the receiving and sending brchs and
          *   have an TO.PRICE.VIEW auth level of 1.
          IF MODE = 'T' AND TO.LEVEL = 1 THEN
             TO.OK = NO
             LOCATE BRS<1,1,2> IN SECURITY<9> SETTING NADA THEN
                LOCATE BRS<1,2,2> IN SECURITY<9> SETTING NADA THEN
                   TO.OK = YES
                END
             END
          END

          BEGIN CASE
          CASE VIEW.NO = 2
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1
             LD.GET LDID
             STAT = LED(6)<1,GEN>

             CK.QTY = QTY
             CK.SZ  = 7

             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C3     = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C3     = CK.QTY FMT
             END
             C4 = CMNT 'L#16'
             PRC = REC<2>*PPER.QTY
             CST = REC<3>*PPER.QTY

             * Check for price overrides
             TYPE = 1
             OE.GET.LI.OVRD.FLAG TYPE,GEN,GEN,PRC.OVRD,LDID

             * Check for cogs overrides
             TYPE = 2
             OE.GET.LI.OVRD.FLAG TYPE,GEN,GEN,CST.OVRD,LDID

             * Check for manual overrides of cost and price
             IF REC<6>#'' THEN PRC.OVRD='*'
             IF REC<7>#'' THEN CST.OVRD='*'
             IF REC<8>#'' THEN
                PRC.OVRD='K'
                CST.OVRD='K'
             END

             * Check if it's a sales line OR a transfer line and it's the
             * sending side and the user is authorized to see COGs and .
             * the user is authorized to see the transfer pricing.
             IF MODE='S' OR (MODE='T' AND QTY<0 AND COGS.OK AND TO.OK AND STAT#'R') THEN
                C5 = OCONV(PRC,'MR9') "R3#10":PRC.OVRD"L#1"
             END ELSE
                C5 = SPACE(11)
             END

             * Check if the user is authorized to see pricing for the
             * different line modes.
             BEGIN CASE
             CASE NOT(COGS.OK)
                C6 = SPACE(11)
             CASE MODE = 'P' AND NOT(PO.OK)
                C6 = SPACE(11)
             CASE MODE = 'T' AND NOT(TO.OK)
                C6 = SPACE(11)
             CASE OTHERWISE
                * For transfers since we don't store COGS in the receiving
                * gen display the price.
                IF MODE='P' OR MODE='A' OR MODE='W' OR (MODE='T' AND STAT='R') THEN
                   C6 = OCONV(PRC,'MR9') "R3#10":PRC.OVRD"L#1"
                END ELSE
                   C6 = OCONV(CST,'MR9') "R3#10":CST.OVRD"L#1"
                END
             END CASE

             BEGIN CASE
             CASE REC<8>
                C7 = '*Kit*'
             CASE MODE = 'T' AND NOT(TO.OK)
                C7 = SPACE(5)
             CASE MODE = 'A'
                C7 = SPACE(5)
             CASE MODE # 'P' AND PRC AND COGS.OK
                GP% = (PRC-CST)/PRC*100
                C7  = GP% "R1#5"
             CASE OTHERWISE
                C7 = SPACE(5)
             END CASE

             PRINT C3:'':C4:'':C5:'':C6:'':C7:

          CASE VIEW.NO = 3
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1
             LD.GET LDID

             CK.QTY = QTY
             CK.SZ  = 7
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C3 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C3 = CK.QTY FMT
             END
             C4 = CMNT 'L#16'
             PRC = REC<2>*PPER.QTY

             * Check for price overrides
             TYPE = 1
             OE.GET.LI.OVRD.FLAG TYPE,GEN,GEN,PRC.OVRD,LDID

             * Check for cost overrides
             TYPE = 3
             OE.GET.LI.OVRD.FLAG TYPE,GEN,GEN,CST.OVRD,LDID

             * Check for manual overrides
             IF REC<6>#'' THEN PRC.OVRD='*'
             IF REC<7>#'' THEN CST.OVRD='*'

             IF REC<8>#'' THEN
                PRC.OVRD='K'
                CST.OVRD=''
                CST = '*Kit*'
             END ELSE
                CST = LD(27)<1,GEN>*PPER.QTY
                BEGIN CASE
                CASE CST # 0
                   * Cost is okay, continue
                CASE MODE = 'T'
                   * For transfers since we don't store COGS in the
                   * receiving gen need to default to price.
                   CST = PRC
                CASE MODE = 'A'
                   * For Adjustments if the cost was not stored in the
                   * ledger then go get it.
                   OE.CALC.COMM.COST GEN,CST
                END CASE
             END

             * For a lot shipment the cogs = comm
             IF REC<12> THEN
                CST = REC<3>*PPER.QTY
             END

             * Check if it's a sales line OR a transfer line and it's the
             * sending side and the user is authorized to see COGs and .
             * the user is authorized to see the transfer pricing.
             IF MODE='S' OR (MODE='T' AND QTY<0 AND COST.OK AND TO.OK) THEN
                C5 = OCONV(PRC,'MR9') "R3#10":PRC.OVRD"L#1"
             END ELSE
                C5 = SPACE(11)
             END

             * Check if the user is authorized to see pricing for the
             * different line modes.
             BEGIN CASE
             CASE NOT(COST.OK)
                C6 = SPACE(11)
             CASE MODE = 'T' AND NOT(TO.OK)
                C6 = SPACE(11)
             CASE MODE = 'P' AND NOT(PO.OK)
                C6 = SPACE(11)
             CASE OTHERWISE
                IF MODE = 'P' OR MODE = 'W' THEN
                   C6 = OCONV(PRC,'MR9') "R3#10":PRC.OVRD"L#1"
                END ELSE
                   C6 = OCONV(CST,'MR9') "R3#10":CST.OVRD"L#1"
                END
             END CASE

             * Display the gross profit.
             BEGIN CASE
             CASE REC<8>
                C7 = '*Kit*'
             CASE MODE = 'T' AND NOT(TO.OK)
                C7 = SPACE(5)
             CASE MODE = 'A'
                C7 = SPACE(5)
             CASE MODE # 'P' AND PRC AND COST.OK
                GP% = (PRC-CST)/PRC*100
                C7  = GP% "R1#5"
             CASE OTHERWISE
                C7 = SPACE(5)
             END CASE

             PRINT C3:'':C4:'':C5:'':C6:'':C7:

          CASE VIEW.NO = 4
             C3 = TYPD "L#7"
             CK.QTY = QTY
             CK.SZ  = 7
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C4 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C4 = CK.QTY FMT
             END

             C5 = FIELD(FIELD(ID,'~',8),'@',1) "L#13"
             * switch lot and location fields for det lot as box#
             * info most important
             IF PN#'' AND PRD.BR(11)='D' THEN
                WRK = FIELD(ID,'~',8)
                TAG = FIELD(WRK,'^',2)
                LOCN=FIELD(WRK,'^',1)
                LOT = FIELD(LOCN,'|',2)
                IF LOT THEN
                   LOCN= FIELD(LOCN,'|',1)
                   C5  = LOT:'/':LOCN
                   IF TAG THEN C5 := '^':TAG
                   C5 = C5"L#13"
                END
             END

             * Do not display dynamic base kit locations
             IF PN # '' AND PRD(106) AND FIELD(ID,'~',11) THEN
                C5 = '' "L#13"
             END

             C6 = CMNT "L#24"

             PRINT C3:'':C4:'':C5:'':C6:

          CASE VIEW.NO = 5
             C3 = TYPD "L#7"
             CK.QTY = QTY
             CK.SZ  = 7
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C4 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C4 = CK.QTY FMT
             END

             OID  = FIELD(ID,'~',4)
             INVN = FIELD(ID,'~',5)+0
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1

             LDID = FIELD(ID,'~',6)
             LD.GET LDID

             C5 = DCOUNT(LD(32)<1,GEN>,SVM)  "R#13"
             IF PN # LD(1) THEN
                LOCATE PN IN LD(31)<1> SETTING KNN THEN
                   C5 = DCOUNT(RAISE(LD(83)<1,GEN,KNN>),SVM) "R#13"
                END
             END
             C6 = CMNT "L#24"
             PRINT C3:'':C4:'':C5:'':C6:

          CASE VIEW.NO = 6
             C3 = TYPD "L#7"
             CK.QTY = QTY
             CK.SZ  = 7
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C4 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C4 = CK.QTY FMT
             END

             OID  = FIELD(ID,'~',4)
             INVN = FIELD(ID,'~',5)+0
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1

             C5 = LED(13)<1,GEN>  "L#19"
             C6 = CMNT "L#18"

             PRINT C3:'':C4:'':C5:'':C6:

          CASE VIEW.NO = 7
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1
             LD.GET LDID
             STAT = LED(6)<1,GEN>

             CK.QTY = QTY
             CK.SZ  = 7
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C3 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C3 = CK.QTY FMT
             END
             C4  = CMNT 'L#11'
             PRC = REC<2>*PPER.QTY
             CST = REC<3>*PPER.QTY

             * Check for price overrides
             TYPE = 1
             OE.GET.LI.OVRD.FLAG TYPE,GEN,GEN,PRC.OVRD,LDID

             * Check for cogs overrides
             TYPE = 2
             OE.GET.LI.OVRD.FLAG TYPE,GEN,GEN,CST.OVRD,LDID

             * Check for manual override
             IF REC<6>#'' THEN PRC.OVRD='*'
             IF REC<7>#'' THEN CST.OVRD='*'

             IF REC<8>#'' THEN
                PRC.OVRD='K'
                CST.OVRD='K'
             END

             * Check if it's a sales line OR a transfer line and it's the
             * sending side and the user is authorized to see COGs and .
             * the user is authorized to see the transfer pricing.
             IF MODE='S' OR (MODE='T' AND QTY<0 AND COGS.OK AND TO.OK AND STAT#'R') THEN
                C5 = OCONV(PRC,'MR9') "R3#10":PRC.OVRD"L#1"
             END ELSE
                C5 = SPACE(11)
             END

             * Check if the user is authorized to see pricing for the
             * different line modes.
             BEGIN CASE
             CASE NOT(COGS.OK)
                C6 = SPACE(11)
             CASE MODE = 'T' AND NOT(TO.OK)
                C6 = SPACE(11)
             CASE MODE = 'P' AND NOT(PO.OK)
                C6 = SPACE(11)
             CASE OTHERWISE
                * For transfers since we don't store COGS in the receiving
                * gen display the price.
                IF MODE='P' OR MODE='A' OR (MODE='T' AND STAT='R') THEN
                   C6 = OCONV(PRC,'MR9') "R3#10":PRC.OVRD"L#1"
                END ELSE
                   C6 = OCONV(CST,'MR9') "R3#10":CST.OVRD"L#1"
                END
             END CASE

             * Display the gross profit.
             BEGIN CASE
             CASE REC<8>
                C7 = '*Kit*'
             CASE MODE = 'T' AND NOT(TO.OK)
                C7 = SPACE(5)
             CASE MODE = 'A'
                C7 = SPACE(5)
             CASE MODE # 'P' AND PRC AND COGS.OK
                GP% = (PRC-CST)/PRC*100
                C7  = GP% "R1#5"
             CASE OTHERWISE
                C7 = SPACE(5)
             END CASE

             PRINT C3:'':C4:'':C5:'':C6:'':C7:

          CASE VIEW.NO = 8
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1
             LD.GET LDID

             C3 = TYPD "L#7"
             CK.QTY = QTY
             CK.SZ  = 7

             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C4 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C4 = CK.QTY FMT
             END
             C5 = CMNT 'L#16'
             * Country of manufacture from duty screen
             C6 = "  ":LD(77)<1,GEN,6> 'L#19'

             PRINT C3:'':C4:'':C5:'':C6:

          CASE VIEW.NO = 9
             MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
             LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1

             C3 = TYPD "L#7"
             CK.QTY = QTY
             CK.SZ  = 7
             * If greater than or equal to 1,000,000 convert to X.XX mil.
             IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                CK.QTY = UT.CONV.MILL(CK.QTY)
                C4 = CK.QTY 'R#7'
             END ELSE
                GOSUB GET.FMT
                C4 = CK.QTY FMT
             END
             LEAD = GET.POREC.LEAD(OID:'.':INVN)
             C5 = LEAD "R#13"
             C6 = CMNT "L#24"

             PRINT C3:'':C4:'':C5:'':C6:

          CASE OTHERWISE
             C3 = TYPD "L#7"
             CK.QTY = QTY
             CK.SZ  = 7
             GOSUB GET.FMT
             IF QTY > 0 THEN
                IF CK.QTY > 999999 THEN
                   CK.QTY = UT.CONV.MILL(CK.QTY)
                   C4 = CK.QTY "R#7"
                   C5 = SPACE(7)
                END ELSE
                   C4 = (CK.QTY FMT)
                   C5 = SPACE(7)
                END
             END ELSE
                IF (CK.QTY # '' AND CK.QTY < -999999) THEN
                   C4=SPACE(7)
                   CK.QTY = UT.CONV.MILL(CK.QTY)
                   C5 = CK.QTY "R#7"
                END ELSE
                   C4=SPACE(7)
                   C5 = (-QTY FMT)
                END
             END

             IF CN THEN
                C6 = SPACE(7)
             END ELSE
                PQTY = LN.OHS<LINE>
                CK.QTY = PQTY/PER
                CK.SZ  = 7
                IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
                   CK.QTY = UT.CONV.MILL(CK.QTY)
                   C6 = CK.QTY "R#7"
                END ELSE
                   GOSUB GET.FMT
                   C6 = (CK.QTY FMT)
                END
             END
             C7 = CMNT "L#22"
             PRINT C3:'':C4:'':C5:'':C6:'':C7:

          END CASE

          RETURN
*-------------------------------------------------------------------------*
GET.TYPE: TYPE    = FIELD(ID,'~',7)
          DIFFBR  = FIELD(ID,'~',10)
          OID     = FIELD(ID,'~',4)
          WK.TYPE = TYPE[1,1]

          BEGIN CASE
          CASE DIFFBR;                        TYPD = 'Br#':DIFFBR
          CASE OID[1,1]='R';                  TYPD = 'Rental'
          CASE UNVERF;                        TYPD = 'UnVerf'
          CASE WK.TYPE = 'S' AND LEN(TYPE)>1; TYPD = 'VCnsgn'
          CASE WK.TYPE = 'S' AND REC<11>='C'; TYPD = 'BCsnTr'
          CASE WK.TYPE = 'S';                 TYPD = 'Stock'
          CASE WK.TYPE = 'F';                 TYPD = 'Defctv'
          CASE WK.TYPE = 'T';                 TYPD = 'Tagged'
          CASE WK.TYPE = 'O';                 TYPD = 'Ovrshp'
          CASE WK.TYPE = 'P';                 TYPD = 'Procure'
          CASE WK.TYPE = 'D' AND REC<12>='1'; TYPD = 'LotShp'
          CASE WK.TYPE = 'D';                 TYPD = 'Direct'
          CASE WK.TYPE = 'E';                 TYPD = 'Except'
          CASE WK.TYPE = 'R';                 TYPD = 'Review'
          CASE WK.TYPE = 'C' AND REC<11>='S'; TYPD = 'CCsnTr'
          CASE WK.TYPE = 'C';                 TYPD = 'CCsnBi'
          CASE WK.TYPE = 'L';                 TYPD = 'Display'
          CASE OTHERWISE;                     TYPD = WK.TYPE
          END CASE

          RETURN
*-------------------------------------------------------------------------*
DISP.HDR: PRINT @(14,1):OCONV(AOD,'D4/') "L#10"

          IF SUPR.AVAILS THEN RETURN

          CK.QTY = STK.OH/PER
          CK.SZ  = 7

          * If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END

          PRINT @(60,1):CK.QTY       "R#7":UM"L#2":TAG.OH/PER   "R#7":UM

          CK.QTY = STK.CMTD/PER
          CK.SZ  = 7

          * If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END

          PRINT @(60,2):CK.QTY       "R#7":UM"L#2":TAG.CMTD/PER "R#7":UM

          CK.QTY = STK.PO/PER
          CK.SZ  = 7
          * If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END

          PRINT @(60,3):CK.QTY       "R#7":UM"L#2":TAG.PO/PER   "R#7":UM

          CK.QTY = STK.XFER/PER
          CK.SZ  = 7
          * If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END

          PRINT @(60,4):CK.QTY       "R#7":UM"L#2":TAG.XFER/PER "R#7":UM

          CK.QTY = STK.INPR/PER
          CK.SZ  = 7
          *** If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END

          PRINT @(60,5):CK.QTY       "R#7":UM"L#2":TAG.INPR/PER "R#7":UM

          CK.QTY = STK.WO/PER
          CK.SZ  = 7
          * If greater than or equal to 1,000,000 convert to X.XX mil.
          IF CK.QTY > 999999 OR (CK.QTY # '' AND CK.QTY < -999999) THEN
             CK.QTY = UT.CONV.MILL(CK.QTY)
          END ELSE
             GOSUB GET.FMT
             CK.QTY = CK.QTY FMT
          END

          PRINT @(60,6):CK.QTY       "R#7":UM"L#2":TAG.WO/PER   "R#7":UM

          RETURN
*-------------------------------------------------------------------------*
GET.FMT:  *** Get format
          IF INDEX (CK.QTY,'.',1) THEN
             XX = LEN(FIELD(CK.QTY,'.',1))
             BEGIN CASE
             CASE XX < CK.SZ-2       ; FMT = "R2#":CK.SZ
             CASE XX = CK.SZ-2       ; FMT = "R1#":CK.SZ
             CASE OTHERWISE          ; FMT = "R0#":CK.SZ
             END CASE
          END ELSE FMT = "R#":CK.SZ

          RETURN
*-------------------------------------------------------------------------*
DISP.VIEW:BEGIN CASE
          CASE VIEW.CURR=VIEW.NO;     RETURN
          CASE VIEW.NO=2
             PRINT @(2,7):'ReferencePostDateIn/OutCustomer/VendorUnit Prc/':PPER.UM "L#2":''

             IF COGS.OK THEN PRINT @(63,7):'Unit COGS':@(75,7):'GP%'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                        '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=3
             PRINT @(2,7):'ReferencePostDateIn/OutCustomer/VendorUnit Prc/':PPER.UM "L#2":''

             IF COST.OK THEN PRINT @(63,7):'Unit Cost':@(75,7):'GP%'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                        '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=4
             PRINT @(2,7):'ReferencePostDateTypeIn/OutLocationCustomer/Vendor'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                        '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=5
             PRINT @(2,7):'ReferencePostDateTypeIn/OutSerial CtCustomer/Vendor'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                         '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=6
             PRINT @(2,7):'ReferencePostDateTypeIn/Out Customer PO#Customer/Vendor'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                         '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=7
             PRINT @(2,7):'Cust P/O#PostDateIn/OutCust/VendorUnit Prc/':PPER.UM"L#2":'Unit COGSGP%'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                        '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=8
             PRINT @(2,7):'ReferencePostDateTypeIn/OutCust/VendorCountry Manufactured'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                        '
             NEXT J
             PRINT @(6,18):'͹'
          CASE VIEW.NO=9
             PRINT @(2,7):'ReferencePostDateTypeIn/OutLead TimeCustomer/Vendor'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                         '
             NEXT J
             PRINT @(6,18):'͹'
          CASE OTHERWISE
             PRINT @(2,7):'ReferencePostDateTypeInOutOn HandCustomer / Vendor'
             FOR J = 1 TO 10
             PRINT @(1,7+J):'                                                                        '
             NEXT J
             PRINT @(2,18):''
             VIEW.NO = 1
          END CASE
          VIEW.CURR = VIEW.NO
          RETURN
*-------------------------------------------------------------------------*
UP.ONE:   IF EOF THEN RETURN
          BSCAN ID FROM PSUBFILE,ROOT USING '&INDEX&' BY 'D' ELSE EOF=YES;RETURN
          SV.ID = ID
          ROOT  = ''
          IF FIELD(ID,'~',1)#PN OR FIELD(ID,'~',2)#BR THEN EOF=YES; RETURN
          READ REC FROM PSUBFILE,ID ELSE REC = ''
          IF CN#'' THEN
IN.TMP:      INPUT XX,-1
             IF XX = 1 THEN
                IF WIN.OPEN THEN
                   WINDOW.CHILD.CLOSE
                   WIN.OPEN = NO
                END
                EOF = YES
                MESS 25,3,'Search Halted....'
                RETURN
             END
             IF NOT(ST.ONLY) THEN
                IF REC<4> # CN AND REC<5> # CN THEN GOTO UP.ONE
             END ELSE
                IF REC<5> # ST.CN THEN GOTO UP.ONE
             END
          END

          OID.TYPE      = FIELD(ID,'~',4)[1,1]
          TYPE          = FIELD(ID,'~',7)
          DIFFBR        = FIELD(ID,'~',10)

          * limited the user viewing the accounts
          IF LIMIT.VIEW THEN
             * limit sale orders only
             IF OID.TYPE = 'S' THEN
                * default set to skip this account
                LIMIT.CHECK.YES  = YES
                * get the LED ID and read the record
                OID = FIELD(ID,'~',4)
                READ TLED FROM LEDFILE,OID ELSE TLED = ''
                * the inside saleperson much be the user
                IF TLED<34,1> = USER.ID THEN
                   * allow the user to view this account.
                   LIMIT.CHECK.YES = NO
                END
                * or the outside saleperson much be the user
                IF TLED<72,1> = USER.ID THEN
                   * allow the user to view this account.
                   LIMIT.CHECK.YES = NO
                END
                IF LIMIT.CHECK.YES THEN
                   * skip this account
                   GOTO UP.ONE
                END
             END ELSE
                ***skip purchase, transfer and adjustment
***  !          GOTO UP.ONE
             END
          END
          *** Selection hot key stuff.
          LOCATE OID.TYPE IN OID.SELS<1> SETTING XX        ELSE GOTO UP.ONE
          WK.TYPE = TYPE[1,1]
          IF WK.TYPE = 'S' AND LEN(TYPE)>1 THEN WK.TYPE = 'V'
          IF LOC.TYPE # 'All' THEN
             LOCATE WK.TYPE IN STK.SELS<1> SETTING XX      ELSE GOTO UP.ONE
          END
          IF SHOW.BR.ONLY AND NOT(DIFFBR)                  THEN GOTO UP.ONE
          IF OPEN.SNS AND DCOUNT(REC<9,1>,SVM)=ABS(REC<1>) THEN GOTO UP.ONE
          IF CUS.PO # '' THEN
             INVN = FIELD(ID,'~',5)+0
             READV INVNS FROM LEDFILE,FIELD(ID,'~',4),8    ELSE GOTO UP.ONE
             LOCATE INVN IN INVNS<1> SETTING GEN           ELSE GOTO UP.ONE
             READV CUS.POS FROM LEDFILE,FIELD(ID,'~',4),13 ELSE GOTO UP.ONE
             IF NOT(INDEX(CUS.POS<1,GEN>,CUS.PO,1))        THEN GOTO UP.ONE
          END
          IF L.PAT AND PRD(3) = 9 THEN
             HAS.LOT = NO
             GOSUB CHK.MATL
             IF NOT(HAS.LOT)                               THEN GOTO UP.ONE
          END
          IF DIFFBR = '' AND INDEX(STK.TYPES.AVL$,TYPE[1,1],1) THEN
             STK.QTY = REC<1>
          END ELSE
             STK.QTY = 0
          END

          * Exclude branch transfers of customer consignment from
          * onhand figure
          IF OID.TYPE = 'T' THEN
             OID = FIELD(ID,'~',4)
             READV TR.CONSIGN FROM LEDFILE,OID,110 ELSE
                TR.CONSIGN = ''
             END
             IF TR.CONSIGN<1,1> = 'C' THEN
                STK.QTY = 0
             END
          END

          * Exclude base components of dynamic kits from onhand figure
          IF PRD(106) THEN
             DCN = FIELD(ID,'~',11)
             IF DCN THEN
                STK.QTY = 0
             END
          END

          * Check unverified stock qtys
          OID = FIELD(ID,'~',4)
          MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
          INV.HIST.CHK.UNVERF ID,EXCLUDE.UNVERF.IP,STK.QTY,RFM.IDS,UNVERF

          MXL += 1
          LN.IDS<MXL>   = ID
          LN.OHS<MXL+1> = LN.OHS<MXL> - STK.QTY
          LN.VFLG<MXL>  = UNVERF
          MOVE = 4

          RETURN
*-------------------------------------------------------------------------*
CHK.MATL: *
          OID  = FIELD(ID,'~',4)
          INVN = FIELD(ID,'~',5)
          LDID = FIELD(ID,'~',6)

          MATREAD LED FROM LEDFILE,OID ELSE RETURN
          LOCATE INVN IN LED(8)<1> SETTING GEN ELSE RETURN
          LD.GET LDID
          PN.LIST = RAISE(LD(59))
          PN.SHP  = RAISE(LD(61))
          FOR MX = 1 TO DCOUNT(PN.LIST,AM)
             IF NOT(PN.SHP<MX,GEN>) THEN CONTINUE
             IF PN.LIST<MX>[1,1] = '/' THEN
                LPN = PN.LIST<MX>[2,255]
                READV LPDESC FROM PRDFILE,LPN,1 ELSE LPDESC = PN.LIST<MX>
             END ELSE
                LPDESC = PN.LIST<MX>
             END
             LPDESC = OCONV(LPDESC,'MCU')
             IF INDEX(LPDESC,L.PAT,1) THEN
                HAS.LOT = YES
                EXIT
             END
          NEXT MX

          RETURN
*-------------------------------------------------------------------------*
SUBS:     ON OPTION GOTO SHOW.ONLY, VIEW.IT, LOCAS, PRD.LDR, INV.INQ, PRINTIT, CHNGV, HISTSUM, VLOG, XREFS, SERS, CHG.DT, CHG.BR, PO.SER, ELOC, LOT.DESC, BT.ST, BR.COST.INQ
*-------------------------------------------------------------------------*
VIEW.IT:  ID   = LN.IDS<LINE>
          OID  = FIELD(ID,'~',4)
          INVN = FIELD(ID,'~',5)
          READV INVNS FROM LEDFILE,OID,8 ELSE INVNS = ''
          LOCATE INVN IN INVNS<1> SETTING GEN ELSE PRINT BELL:; RETURN
          MODE      = OID[1,1]
          INIT.VIEW = 1
          VIEW.ONLY = YES
          VIEW.EDIT.LED OID,GEN:VM:PN,VIEW.ONLY,INIT.VIEW
          RETURN
*-------------------------------------------------------------------------*
LOCAS:    PRD.LOCATION.MAINT PN:AM:BR:AM:1
          RETURN
*-------------------------------------------------------------------------*
PRD.LDR:  PRODUCT.LEDGER BR,PN
          RETURN
*-------------------------------------------------------------------------*
INV.INQ:  IF NOT(SUPR.AVAILS) THEN
             INV.INQ PN,BR
             END
          RETURN
*-------------------------------------------------------------------------*
PRINTIT:  *** Print it
          INV.DVR.HISTORY.PRINT PN,AOD,BR,CN,VIEW.NO
          RETURN
*-------------------------------------------------------------------------*
CHNGV:    CHOICES = ''
          CHOICES<1,1> = 'Customer / On-Hand'
          CHOICES<1,2> = 'Selling Price'
          CHOICES<1,3> = 'Selling Price'
          CHOICES<1,4> = 'Customer / Location'
          CHOICES<1,5> = 'Customer / Serial #'
          CHOICES<1,6> = 'Customer / Customer P/O'
          CHOICES<1,7> = 'Cust PO / Selling Price'
          CHOICES<1,8> = 'Customer / Manufacture Country'
          CHOICES<1,9> = 'Customer / Lead Time'

          IF COGS.OK THEN CHOICES<1,2> := ' / COGS / GP%'
          IF COST.OK THEN CHOICES<1,3> := ' / Cost / GP%'
          IF COGS.OK THEN CHOICES<1,7> := ' / COGS'
          MENU.TABLE XX,25,10,1,9,30,,,CHOICES,'View Choices',VIEW.NO

          LOCATE XX IN CHOICES<1> SETTING VIEW.NO ELSE RETURN
          GOSUB DISP.VIEW
          GOSUB REDISP
          RETURN TO VIEW.C
*-------------------------------------------------------------------------*
VIEW.C:   *** just a dumb routine to make returns line up
          RETURN TO MOVENEXT
*-------------------------------------------------------------------------*
REDISP:   SV = LINE
          IF TOP < 10 THEN BOT=1 ELSE BOT=TOP-9
          FOR LINE = BOT TO TOP
             GOSUB DISP.LN
          NEXT LINE
          LINE = SV
          RETURN
*-------------------------------------------------------------------------*
HISTSUM:  IF REMOTE.CUST THEN RETURN
          PRD.SALES.HIST PN:AM:BR
          RETURN
*-------------------------------------------------------------------------*
VLOG:     PRD.LOG.VIEW BR,PN
          RETURN
*-------------------------------------------------------------------------*
XREFS:    PRD.XREF.VIEW PN
          RETURN
*-------------------------------------------------------------------------*
SERS:     *** Enter serial numbers for this order
          MATBUILD SV.LED    FROM LED
          MATBUILD SV.LD     FROM LD
          MATBUILD SV.OLED   FROM OLED
          MATBUILD SV.OLD.LD FROM OLD.LD

          * Set up the OID, LDID, Invoice# and Generation #.
          OID  = FIELD(LN.IDS<LINE>,'~',4)
          INVN = FIELD(LN.IDS<LINE>,'~',5)+0
          LDID = FIELD(LN.IDS<LINE>,'~',6)
          MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
          LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1
          LD.GET LDID
          MAT OLED   = MAT LED
          MAT OLD.LD = MAT LD

          * Lock the ledger record and tell them to try again
          * if already locked.
          NO.MSG = YES
          OE.LOCK.LED OID,LOCK.MSG,NO.MSG
          IF LOCK.MSG THEN
             LOCK.MSG = LOCK.MSG<1>
             IF LOCK.MSG[1,3] = 'You' THEN
                LOCK.MSG = FIELD(LOCK.MSG,',',1)
             END
             MESS 1,2,LOCK.MSG
IN$$7:       INPNO A,,,0
             UPD.OK = NO
             GOTO UPD.SER.END
          END

          IF LED(6)<1,GEN>='B' THEN
             ERR.MESS 30,3,BELL:'Ser# Entry Not Allowed On Bid'
IN$$8:       INP A,,,0
             OE.UNLOCK.LED OID
             GOTO UPD.SER.END
          END

          OE.SERIAL.CHECK OID,GEN,LDID,PRD.BR(25),1,NO,,YES

          * Update the ledger information
          UPDATE.LEDGER.DET OID,LDID,1,'',''
          UPDATE.LEDGER OID,''
          OE.UNLOCK.LED OID

UPD.SER.END: ***
          MATPARSE LED    FROM SV.LED
          MATPARSE LD     FROM SV.LD
          MATPARSE OLED   FROM SV.OLED
          MATPARSE OLD.LD FROM SV.OLD.LD
          QUIT = NO; F12 = NO

          RETURN
*-------------------------------------------------------------------------*
CHG.DT:   *** Change the As of Date we're looking at.
          MENU.CLEAR
IN.DT2:   INPNO AOD,14,1,10,'D4/'
          GOSUB HOT.KEYS

          RESEL = YES
          RETURN TO RESTART
*-------------------------------------------------------------------------*
CHG.BR:   *** Change the branch we're looking at.
IN.BR2:   INP.BRNO 29,1,4,BR
          RESEL = YES
          RETURN TO RESTART
*-------------------------------------------------------------------------*
PO.SER:   *** Search for the customer po #.
          RESEL = YES
IN$$5:    INP.PROMPT CUS.PO,'Customer P/O # : ',,20
          WORD = 'XX'
          GOSUB SHOW.SET
          RETURN TO RESTART
*-------------------------------------------------------------------------*
ELOC:     *** Change the location of this order...(not for directs)
          ID   = LN.IDS<LINE>
          OID  = FIELD(ID,'~',4)
          INVN = FIELD(ID,'~',5)
          LDID = FIELD(ID,'~',6)
          LOCA = FIELD(ID,'~',7,2)
          LOC  = FIELD(LOCA,'^',1)
          TAG  = FIELD(LOCA,'^',2)
          CP   = FIELD(ID,'~',9)+0
          IF LOC.TYPE = 'D' THEN PRINT BELL:; RETURN

          * Do not allow editting to take place on an 'InProcess' item
          MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
          LOCATE INVN IN LED(8)<1> SETTING GEN ELSE GEN = 1
          GID = LED(12)<1,GEN>
          WID = LOC:'~':OID:'.':GID:'.':LDID:'.':CP
          IF TAG THEN WID := '^':TAG
          FINDSTR WID IN PRDD.BR(8) SETTING XX,FND.POS THEN
             IF FIELD(PRDD.BR(8)<1,FND.POS>,'~',4) THEN
                MESS 10,3,'Inprocess Qty - No Editing Allowed'
IN$$9:          INP X,1,LINE,0
                RETURN
             END
          END

          OE.EDIT.PN.LOC ID

          RESEL = YES
          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.ONLY:*** Show Only
          OPEN.SNS = NO
          MENU.TABLE WORD,35,8,1,8,15,,,VALID.SELS,'Sales Types'

          IF QUIT THEN RETURN TO RESTART

          LOCATE WORD IN VALID.SELS<1> SETTING OPT ELSE GOTO SHOW.ONLY

          RESEL = YES

          ON OPT GOTO SHOW.ALL,SHOW.SALES,SHOW.PURCH,SHOW.TRANS,SHOW.ADJUST,SHOW.WOS,SHOW.SNS,SHOW.RNTLS

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.ALL: *** Show all
          SHOW.BR.ONLY = NO
          OID.SELS = ORIG.OID.SELS
          STK.SELS = ORIG.STK.SELS

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.SALES:*** Show sales
          MENU.TABLE WORD,35,8,1,12,15,,,SALES.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          OID.SELS = 'S'
          GOSUB SHOW.SET

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.PURCH:*** Show purchase
          MENU.TABLE WORD,35,8,1,10,15,,,PURCH.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          OID.SELS = 'P'
          GOSUB SHOW.SET

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.TRANS:*** Show transactions
          MENU.TABLE WORD,35,8,1,8,15,,,TRANS.SELS,'Stock Types'
          IF QUIT THEN QUIT=NO; GOTO SHOW.ONLY

          OID.SELS = 'T'
          GOSUB SHOW.SET

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.ADJUST:*** Show adjustments
          SHOW.BR.ONLY = NO
          OID.SELS = 'A'
          STK.SELS = ORIG.STK.SELS

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.WOS: *** Only show work orders
          SHOW.BR.ONLY = NO
          OID.SELS = 'W'
          STK.SELS = ORIG.STK.SELS

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.RNTLS:*** Only show Rentals
          SHOW.BR.ONLY = NO
          OID.SELS     = 'R'
          STK.SELS     = ORIG.STK.SELS

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.SNS: *** Serial numbers
          WORD = 'XX'
          GOSUB SHOW.SET
          OPEN.SNS = YES
          VIEW.NO  = 5
          RETURN TO RESTART
*-------------------------------------------------------------------------*
SHOW.SET: *** Show set
          LOC.TYPE = WORD
          BEGIN CASE
          CASE WORD='All'
             SHOW.BR.ONLY = NO
             STK.SELS     = ORIG.STK.SELS
          CASE WORD='Directs'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'D'
          CASE WORD='Stock'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'S'
          CASE WORD='Defective'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'F'
          CASE WORD='Over Shipment'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'O'
          CASE WORD='Review'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'R'
          CASE WORD='Display'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'L'
          CASE WORD='Tagged'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'T':VM:'P'
          CASE WORD='Procure'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'P'
          CASE WORD='Except'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'E'
          CASE WORD='Remnant'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'M'
          CASE WORD='VendCnsgn'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'V'
          CASE WORD='CustCnsgn'
             SHOW.BR.ONLY = NO
             STK.SELS     = 'C'
          CASE WORD='BR...'
             SHOW.BR.ONLY = YES
             STK.SELS     = ORIG.STK.SELS
          CASE OTHERWISE
             *** This is the All case.
             SHOW.BR.ONLY = NO
             OID.SELS     = ORIG.OID.SELS
             STK.SELS     = ORIG.STK.SELS
          END CASE
          RETURN
*-------------------------------------------------------------------------*
LOT.DESC: *** Select orders that have Lot Item Mat'l detail matching desc.

          IF PRD(3) # 9 THEN PRINT BELL; RETURN

IN.LPAT:  INP.PROMPT L.PAT,'Search Material Detail For : ','MCU',25
          IF NOT(L.PAT) THEN
             RETURN
          END

          NEW.LPAT = YES
          RESEL = YES
          RETURN TO RESTART
*-------------------------------------------------------------------------*
BT.ST:    *** Bill-To or Ship-To
          IF NOT(ST.CN) THEN RETURN

          IF ST.ONLY THEN
             ST.ONLY = NO
          END ELSE
             ST.ONLY = YES
          END

          RETURN TO RESTART
*-------------------------------------------------------------------------*
BR.COST.INQ:*** Display the Branch Cost Inquiry screen
          BR.COST.INQ BR:AM:PN

          RETURN
*-------------------------------------------------------------------------*
INIT:     *** Initialize the selection data.

          VALID.SELS = 'All,Sales,Purchases,Transfers,Adjustments,Work Orders,Open Serial,Rentals'
          SALES.SELS = 'All,Stock,Directs,Tagged,Defective,Review,Over Shipment,Display,Except,Remnant,Procure,CustCnsgn,BR...'
          PURCH.SELS = 'All,Stock,Directs,Tagged,Defective,Review,Over Shipment,Display,Procure,VendCnsgn,BR...'
          TRANS.SELS = 'All,Stock,Tagged,Defective,Review,Overship,Display,Procure,BR...'

          IF NOT(DFLT.SO) THEN
             OID.SELS = 'S,P,T,A,W,R'
          END ELSE
             OID.SELS = DFLT.SO
          END
          STK.SELS = 'S,F,O,R,L,T,D,P,E,M,V,C'
          LOC.TYPE = 'All'

          CONVERT ',' TO VM IN VALID.SELS
          CONVERT ',' TO VM IN SALES.SELS
          CONVERT ',' TO VM IN PURCH.SELS
          CONVERT ',' TO VM IN TRANS.SELS
          CONVERT ',' TO VM IN OID.SELS
          CONVERT ',' TO VM IN STK.SELS

          ORIG.OID.SELS = OID.SELS
          ORIG.STK.SELS = STK.SELS

          RESEL         = NO
          CUS.PO        = ''
          SHOW.BR.ONLY  = NO
          NEW.LPAT      = NO
          L.PAT         = ''

          IF NOT(KEEP.CN) THEN
             IF REMOTE.CUST THEN CN = REMOTE.CUST ELSE CN = BT.CN
          END
          IF NOT(ST.CN) THEN
             PRINT @(60,21):'            '    ;** Blank out hotkey.
          END

          CST.OVRD = ''
          PRC.OVRD = ''

          RETURN
*-------------------------------------------------------------------------*
NONE.MSG: *** If there are items, then do nothing.

          IF LN.IDS='' THEN
             MENU.CLEAR
             MENU.LOAD 74,19, 4, 1,'S';    * Show
             MENU.LOAD ,,,,""
             * Don't make Loc. Hotkey active when viewing a Lot Item.
             IF PRD(3) # 9 THEN
                MENU.LOAD  6,19, 9, 1,"L"; * Locations
             END
             MENU.LOAD 16,19,11, 1,'F';    * Future Ledger
             MENU.LOAD 28,19, 9, 1,'I';    * Inventory Inquiry
             MENU.LOAD ,,,,""
             MENU.LOAD ,,,,""
             MENU.LOAD ,,,,""
             MENU.LOAD ,,,,""
             MENU.LOAD ,,,,""
             MENU.LOAD ,,,,""
             MENU.LOAD 15,21, 4, 2,'A';    * Change As of Date
             MENU.LOAD 22,21, 2, 1,'B';    * Change Branch

             MSG  = 'No items found. Change Br or Date select criteria '
             MSG := 'or press Esc to exit.'
MESS.INP:    MESS 2,8,MSG
IN$$6:       INP A,0,0,0
             IF QUIT THEN
                RESEL = NO
                * If called, exit, else go back to cust prompt
                IF INIT.PN THEN RETURN TO FINISH ELSE RETURN TO START
             END
             GOTO MESS.INP
          END

          RETURN
*-------------------------------------------------------------------------*
RESTART:  *** Restart
          RETURN TO START
*-------------------------------------------------------------------------*
FINISH:   LDATA = LN.IDS<LINE>
          MATPARSE LED    FROM SAVE.LED
          MATPARSE LD     FROM SAVE.LD
          MATPARSE OLED   FROM SAVE.OLED
          MATPARSE OLD.LD FROM SAVE.OLD.LD
          WINDOW.CLOSE
          RETURN
*-------------------------------------------------------------------------*
!CASEY~07/22/09~18:12

!SMITJR~09/27/11~23:11
